<%
Class Info
'Catelog

private InfoMdb		'=	"L_cat"				'数据库
private objPageLimit	
private sqlstr
'-------------------------------------------
Property Get PInfoMdb
	PInfoMdb=InfoMdb
End Property
Property Let PInfoMdb(InfoMdbs)
	InfoMdb=InfoMdbs
End Property

property Get pPageLimit
	pPageLimit = objPageLimit
End property 
property let pPageLimit(pagel)
	objPageLimit = pagel
End property 
sub Class_Initialize()
	pPageLimit = 15 

End Sub 
Sub class_Terminate

End Sub 

'
'-------------------
public Function AddNew(arrstr)				'传入一维数组
 
	if not isarray(arrstr) Or uBound(arrstr)<11 then 
		AddNew = false
		exit Function
	End if
	Dim newPath,newID
	set rs=server.createobject("adodb.recordset")
	sqlstr ="select top 1 * from "&InfoMdb&" "
	on error resume next
	rs.open sqlstr,conn,1,3
	Dim HtmlOrnot
	If killint(arrstr(9),0,0,1) = 0 Then 
		HtmlOrnot = False 'UBB格式
	Else
		HtmlOrnot =True 
	End If 
	'True表示为Html标签.
	'if not(rs.eof and rs.bof) then 
		rs.addnew
		rs("cat_id")			=	arrstr(1)
		rs("user_id")			=	arrstr(2)
		rs("info_level")		=	arrstr(3)
		rs("info_title")		=	arrstr(4)
		rs("info_weather")		=	arrstr(5)
		rs("info_rank")			=	arrstr(6)
		rs("info_content")		=	arrstr(7)
		rs("info_ip")			=	arrstr(8)
		rs("info_htmlorubb")	=	HtmlOrnot
		rs("info_tags")			=	arrstr(11)
		rs.update 
		newID=rs("info_id")
		
		newPath=arrstr(10)

		If(( IsNull(newPath) ) Or ( len(newPath)<3) Or (not IsValidUserName(ClearHtml(HTMLEncode(newPath))))) Then 
			newPath = newID & SystemCacheFileExt
		End If 
		If(ExistsPath(0,arrstr(1),newPath)) Then newPath = Generator(16) & SystemCacheFileExt
		rs("info_path") =	newPath
		rs.update 
	'End if 
	rs.close
	Call CreateXmlFile(newID)
		If Err Then
			response.write (err.Description)
			err.Clear
			AddNew = false 
		else
			AddNew = true
		End if
	Set rs=nothing 
End Function
Function ExistsPath(iid,cid,strPath)
	If(Len(strPath)<3) Then 
		ExistsPath = False 
		Exit Function 
	End If 
	Dim sqled ,exitBool
	exitBool= False  
	Dim newRs
	set newRs=server.createobject("adodb.recordset")
	sqled = "select [cat_id],[info_id] from [L_info] where info_path='"& Replace(strPath,"'","") &"'"
	newRs.open sqled,conn,1,3
	if not(newRs.eof and newRs.bof) then 
		Do While Not newRs.eof 
			If killint(newRs(0),0,0,10) = killint(cid,0,0,10) Then 
				If (killint(iid,0,0,10) = 0) Or (killint(iid,0,0,10) <> killint(newRs(1),0,0,10) ) Then 
				exitBool = True  
				Exit Do 
				End If 
			End If 
		newRs.movenext 
		Loop 
	End if 
	newRs.close
	Set newRs=nothing 
	ExistsPath = exitBool
End Function 
public Function Delete(info_id)
		sqlstr="delete from  "&InfoMdb&"  where [info_id]="&info_id&""
		on error resume next
		conn.execute(sqlstr)
		If Err Then
			response.write (err.Description)
			err.Clear
			Delete = false 
		else
			Delete = true
		End if

End Function 
'---------------------
public Function GetLimitInfo(pages,cat_id)
	if not isnumeric(pages) then pages=1
	cat_id =Trim(cat_id)
	if pages < 1 then pages = 1 
		Dim tempall:tempall= GetAllResult(cat_id)
	if  pages * objPageLimit > tempall then pages = GetPageCount (tempall,objPageLimit)

	'	pages= int(pages)
	Dim newStr
	newStr= cat_id
	Dim tempsql
	if IsInteger(cat_id) and killint(cat_id,0,0,10) > 0    then 
		tempsql = "   (A.[cat_id]= "&newStr&") "
	ElseIf ((StrComp(Left(cat_id,1),"(")=0)=True  And  (StrComp(right(cat_id,1),")")=0)  )=True   Then 
		tempsql = "   (A.[cat_id] in "&newStr&")"
	else
		tempsql = "  (1 =1)"
	End If
	tempsql = "(1=1) and " &  tempsql
		if pages <=1 then 
			sqlstr = "select top "&objPageLimit&" [info_id],[cat_id],[info_title],[info_time],[info_hit],[info_path] from "&InfoMdb&" A where  "&tempsql& " order by [info_id] desc"
	'	elseif  pages * objPageLimit >= tempall then 
	'		sqlstr = "select top "&objPageLimit&" [info_id],[cat_id],[info_title],[info_time],[info_hit] from "&InfoMdb&" where "&tempsql&" order by [info_id] asc  "
		else
			sqlstr = "select top "&objPageLimit&" [info_id],[cat_id],[info_title],[info_time],[info_hit],[info_path] from "&InfoMdb&" A where ([info_id] not in (select top "&(pages-1)*objPageLimit&" [info_id] from "&InfoMdb&"  where "&tempsql&" order by [info_id] desc ))  and "&tempsql&"  order by [info_id] desc"
		End if 

	GetLimitInfo = GetRows(sqlstr)
	
End Function 
Public Function GetXmlInfoList(pages,cat_id)
	Dim arrs:arrs= GetLimitInfo(pages,cat_id)
	Dim strMess,Ai
	strMess = "<Nodes>"
	If(IsArray(arrs)) Then 
		For Ai =0 To UBound(arrs,2)
			strMess = strMess & "<Node id="""& arrs(0,Ai) &"""><cat id=""" & arrs(1,Ai) & """>"& GetCatName(arrs(1,Ai)) &"</cat><title><![CDATA["& arrs(2,Ai) &"]]></title><time>"& arrs(3,Ai) &"</time><path>"&  IIF(NeedHtmlPage,GetCatlogueURLPath(  arrs(1,Ai) )  &  arrs(5,Ai),BaseURI & "item.asp?id=" & arrs(0,ai))&"</path></Node>"

		Next 
	End If 
	strMess = strMess & "</Nodes>"
	GetXmlInfoList= strMess
End Function 
public Function GetAllResult(byval cat_id)'没有递归计数
	Dim newStr
	newStr= cat_id
	if IsInteger(cat_id) and killint(cat_id,0,0,10) > 0    then 
		sqlstr="select count(0) from "&InfoMdb&" where [cat_id]="&newStr&""
	ElseIf ((StrComp(Left(cat_id,1),"(")=0)=True  And  (StrComp(right(cat_id,1),")")=0)  )=True   Then 
		sqlstr="select count(0) from "&InfoMdb&" where [cat_id] in "&newStr&""
	else
		sqlstr="select count(0) from "&InfoMdb&"  "
	End if
	GetAllResult = GetOne(sqlstr)
End Function 
public Function GetById(ids)
	sqlstr="select [info_id],[cat_id],[user_id],[info_level],[info_title],[info_weather],[info_rank],[info_content],[info_ip],[info_htmlorubb],[info_hit],[info_time],[info_path],[info_tags] from "&InfoMdb&" where [info_id]="&ids&"  "
	GetById =  GetRows(sqlstr) 
End Function 
public Function GetLasiInfoIDByUser(uid)
	sqlstr="select max([info_id]) from "&InfoMdb&" where [user_id]="&uid&"  "
	GetLasiInfoIDByUser =  GetOne(sqlstr) 
End Function 


'-------------------------------------------
Public Function CreateXmlFile(id)
	Dim xFilepath,sFileName
	xFilepath = server.mappath("../") & "/" & XmlFilePath
	CreateXmlFile = False 
	Dim arrs:arrs=GetById(id)
	If Not IsArray(arrs) Then Exit Function 
	xFilepath =Replace( Replace(xFilepath,"/","\"),"\\","\")
	If Not CreateFolder(xFilepath) Then Exit Function 
	Dim objXML,objXMLroot,NodeI,CDATASection,TNode,ContentStr
	ContentStr=arrs( 7 , 0)
	If(Not arrs( 9 , 0) )Then ContentStr = bbcode(ContentStr)
	Set objXML=Server.CreateObject( XmlDomObjectName )
	objXML.async = false
	objXML.resolveExternals = false
	objXML.PreserveWhiteSpace = False 
	sFileName=arrs(0 , 0) & ".xml"
	If(( IsNull(sFileName) ) Or ( IsEmpty(sFileName)) Or (not IsValidUserName(ClearHtml(HTMLEncode(sFileName))))) Then 
		sFileName = arrs(0,0) & SystemCacheFileExt
	End If 


	Set objXMLroot = objXML.CreateElement("Root") 
		Dim version
		Set   version   =   objXML.createProcessingInstruction("xml","   version='1.0'   encoding='utf-8'")   
		objXML.appendChild(version)   

		Set NodeI = objXML.CreateElement("Info") 
		Call NodeI.SetAttribute("ID",arrs(0,0))
		Call NodeI.SetAttribute("Cache",Now())
		objXMLroot.appendChild(NodeI)   

		Set TNode = objXML.CreateElement("Title") 
		TNode.Text=HTMLEncode( arrs( 4 , 0) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("CatID") 
		TNode.Text=HTMLEncode( arrs( 1 , 0) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("UserID") 
		TNode.Text=HTMLEncode( arrs( 2 , 0) )
		NodeI.appendChild(TNode)
		Set TNode = objXML.CreateElement("UserName") 
		TNode.Text=HTMLEncode( GetUserByID(arrs( 2 , 0)) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("Level") 
		TNode.Text=HTMLEncode( arrs( 3 , 0) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("Weather") 
		Dim weather:weather =WeatherArr()
		TNode.Text=HTMLEncode(weather(1, arrs( 5 , 0) ))
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("Rank") 
		TNode.Text=HTMLEncode( arrs( 6 , 0) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("Content") 
		Set   CDATASection   =   objXML.createCDATASection(  ContentStr )
		TNode.appendChild(CDATASection )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("IP") 
		TNode.Text=HTMLEncode( arrs(8 , 0) )
		NodeI.appendChild(TNode)

		Set TNode = objXML.CreateElement("Tags") 
		TNode.Text=HTMLEncode( arrs(13 , 0) )
		NodeI.appendChild(TNode)



		Set TNode = objXML.CreateElement("Hit") 
		TNode.Text=HTMLEncode( arrs(10 , 0) )
		NodeI.appendChild(TNode)
		Set TNode = objXML.CreateElement("Time") 
		TNode.Text=( arrs(11 , 0) )
		NodeI.appendChild(TNode)

	objXML.appendChild(objXMLroot)   

	
	objXML.Save(xFilepath   & sFileName )
	CreateXmlFile=True 
End Function 
Function GetLastReplyID(ip)
	GetLastReplyID = (GetOne("select max([reply_id]) from  [L_reply] where [reply_ip]='"& ip & "'"))
End Function 
Function GetTitle(id)
	GetTitle = (GetOne("select [info_title] from  [L_info] where [info_id]="& killint(id,0,0,10) & ""))
End Function 
Function GetCatalogueID(id)
	GetCatalogueID = (GetOne("select top 1 [cat_id] from  [L_info] where [info_id]="& killint(id,0,0,10) & ""))
End Function 


'-------------------------------------------
public Function Edit(arrstr)
	if not isarray(arrstr) Or uBound(arrstr)<11 then 
		Edit = false
		exit Function
	End if
	set rs=server.createobject("adodb.recordset")
	sqlstr ="select top 1 * from "&InfoMdb&" where [info_id]="&arrstr(0)&" "
	'on error resume next
	rs.open sqlstr,conn,1,3
	Dim newPath
	newPath=arrstr(10)
	If(( IsNull(newPath) ) Or ( len(newPath)<3) Or (not IsValidUserName(ClearHtml(HTMLEncode(newPath))))) Then 
		newPath = arrstr(0) & SystemCacheFileExt
	End If 
	If(ExistsPath(arrstr(0),arrstr(1),newPath)) Then newPath = Generator(16) & SystemCacheFileExt
	Dim HtmlOrnot

	If killint(arrstr(9),0,0,1) = 0 Then 
		HtmlOrnot = False 
	Else
		HtmlOrnot =True 
	End If 
	if not(rs.eof and rs.bof) then 
		rs("cat_id")			=	arrstr(1)
'		rs("user_id")			=	arrstr(2)
		rs("info_level")		=	arrstr(3)
		rs("info_title")		=	arrstr(4)
		rs("info_weather")		=	arrstr(5)
		rs("info_rank")			=	arrstr(6)
		rs("info_content")		=	arrstr(7)
'		rs("info_ip")			=	arrstr(8)
		rs("info_htmlorubb")	=	HtmlOrnot
		rs("info_path")			=	newPath
		rs("info_tags")			=	arrstr(11)
		rs.update 
	End if 
	rs.close
	Set rs=nothing 
	Call CreateXmlFile(arrstr(0))
		If Err Then
			response.write (err.Description)
			err.Clear
			Edit = false 
		else
			Edit = true
		End if
	
End Function 
Function ExistID(iPrimaryID)
	ExistID = (GetOne("select count(0) from  "&InfoMdb&" where [info_id]="& killint(iPrimaryID,0,0,10))>0)
End Function 
Function GetFullPath(iPrimaryID)
	If(ExistID(iPrimaryID)) Then 
	Dim arrs
		sqlstr="select [cat_id],[info_path],[info_tags] from "&InfoMdb&" where [info_id]="&iPrimaryID&"  "
		arrs =  GetRows(sqlstr) 
		If(Not IsArray(arrs)) Then Exit Function 
		GetFullPath = GetCataloguePath( arrs(0,0) )  &   arrs(1,0)
	End If 
End Function 
'---------------------



'-------------------------------------------
End class
%>